#!/usr/bin/perl

#===============
# * 2013 Copyright Matthew Caswell
# * Pool.pl
#-------
# * Pool language translator/compiler.
# * P.O.O.L - Perl Object Oriented Language
#===============

use strict;
use Data::Dumper;

use constant POOL_VERSION => "A30r02";
my $POOL_VERSION = "A30r02";

print "This is Pool/".POOL_VERSION."\n";

unless($#ARGV >= 1){
  die "Usage: Pool.pl <+[c]> <Pool_class> <Pool_export_class>\n";
}

my($CMDLSwitch, $PoolClassFile, $PoolExportClassFile) = @ARGV[0..2];

print "[Debug] Looding pool class\n";

$PoolClassFile .= ".pool";
$PoolExportClassFile .= ".pm";

open my$PoolClassFileHandler, $PoolClassFile
  or die "[STDERR] Could not open $PoolClassFile!\n[Perl] ". $! . "\n";

  my $PoolClass = do{ local $/; <$PoolClassFileHandler> };
  
close($PoolClassFileHandler);

print "[Debug] Starting package constructor\n";

my $POOLedPackage = "use strict;\n\n";

print "[Debug] Starting Pool fragmentation\n";
my @lines = grep length, split /\n/, $PoolClass;
 
my $inClass = 0;
my $POOLedPackageNameStub;
my $PackageSet = 0;
my $InternalOn;
my $localOn;
my $inExport;
my $POOLedPackageOriginalName;
my $inlineState = 0;
# PACKAGE
for my$index (0..$#lines){
    my $lineNu = $index+1;
    my @thisline = grep length, split /\s/, $lines[$index];
    if($thisline[0] eq "package"){
        print "[Debug] Found package\n";
        my @packName = grep length, split '', $thisline[1];
        if($packName[$#packName] eq ';'){
            $thisline[1] = join('', @packName[0..$#packName-1]);
            $POOLedPackageOriginalName = $thisline[1];
            @packName = grep length, split /\./, $thisline[1];
            my $POOLPackName;
        #    print Dumper(@packName);
            if($#packName != 0){
                print "[Debug] Fixing package name\n";
                $POOLPackName = join("::", @packName);
            }else{
                $POOLPackName = $thisline[1];
            }
            $POOLedPackageNameStub .= "package $POOLPackName";
        }else{
            die "[STDERR] In line $lineNu: ';' expected at EOL\n";
        }
    }elsif($thisline[0] eq "export" && $inClass == 0){
        print "[Debug] Found export\n";
        my @className = grep length, split '', $thisline[1];
        my $RealClassName;
        if($className[$#className] eq "{"){
            $RealClassName = join('', @className[0..$#className-1]);
        }else{
            $RealClassName = join('', @className);
        }
        print "[Debug] Fixing class names\n";
        $POOLedPackage .= <<EOF;
#===============================================
# * This Perl module has been generated by     *
# * Matthew Caswell's original Pool compiler   *
# * (which was also written in Perl).          *
# * The data and text below should be correct, *
# * and should follow the basic structure of   *
# * a Pool export class (which is translated   *
# * to Perl and stuck in a module).            *
# * ------------------------------------------ *
# * This module's original name:               *
# * $PoolExportClassFile                       
# * This module's original package name:       *
# * $POOLedPackageOriginalName                     
# * This module's original class name:         *
# * $RealClassName                             
# *   --\$\$-- Pool/$POOL_VERSION              
#===============================================
EOF
        $POOLedPackage .= $POOLedPackageNameStub . "::" . $RealClassName . ";\n\n";
        $POOLedPackage .= <<EOF;
my \$internal = {};
 
EOF
        $inClass = 1;
        $PackageSet = 1;
    }elsif($thisline[0] eq "export" && $inClass == 1){
        print "[Debug] Found method export\n";
        $inExport = 1;
        #print Dumper(@thisline);
        my @func = grep length, split /[\(\)]/, $thisline[2];
        #print Dumper(@func);
        my $exportName = $func[0];
        $POOLedPackage .= <<EOF;
sub $exportName {
EOF
        if($func[1] eq "vector"){
            $POOLedPackage .= <<EOF;
my\@$func[2] = \@_;
EOF
        }elsif($func[1] eq "void"){}
    }elsif($thisline[0] eq "internal"){
        print "[Debug] Found method internal\n";
        #print Dumper(@thisline);
        my@func = grep length, split /[\(\)]/, $thisline[2];
        #print Dumper(@func);
        my $internalName = $func[0];
        $POOLedPackage .= <<EOF;
\$internal = {
    $internalName => sub{
EOF
        if($func[1] eq "vector"){
                        $POOLedPackage .= <<EOF;
        my\@$func[2] = \@_;
EOF
        }elsif($func[1] eq "void"){}
        $InternalOn = 1;
    }elsif($thisline[0] eq "Console.println"){
        $POOLedPackage .= "print STDOUT ";
        my @fry = @thisline[1..$#thisline];
        foreach my$meh (@fry){
            $POOLedPackage .= $meh . " ";
        }
        $POOLedPackage .= "\n";
    }elsif($thisline[0] eq "}"){
        if($InternalOn == 1){
            $POOLedPackage .= <<EOF;
    },
};
EOF
            $InternalOn = 0;
        }elsif($inClass == 1 && $InternalOn == 0
          && $inExport == 0){
            $POOLedPackage .= "\n1;";
            $inClass = 0;
        }elsif($inExport == 1 && $inClass == 1){
            $POOLedPackage .= "\n}\n";
            $inExport = 0;
        }
    }elsif($thisline[0] eq "this.method"){
      @thisline = grep length, split /[\s\(\)]/, $lines[$index];
      my $internalMethodCallName = "\$internal->{$thisline[1]}";
      my @cc = grep length, split '', $thisline[2];
      if($cc[0] eq "\""){
        $internalMethodCallName .= "(".join(" ", @thisline[2..$#thisline-1]);
      }elsif($thisline[2] eq "vector"){
        $internalMethodCallName .= "(\@".$thisline[3];
      }elsif($thisline[2] eq "void"){
        $internalMethodCallName .= "(";
      }else{
        die "[STDERR] In line $lineNu: unknown type in this.method ()\n";
      }
      $POOLedPackage .= "$internalMethodCallName);\n";
    }elsif($thisline[0] eq "import"){
      print "[Debug] Found imported package\n";
      my @importPackageArray = grep length, split '', $thisline[1];
      if($importPackageArray[$#importPackageArray] eq ";"){
        my $importPackageName = join('', @importPackageArray[0..$#importPackageArray-1]);
        @importPackageArray = grep length, split /\./, $importPackageName;
        $importPackageName = join("::", @importPackageArray);
        $POOLedPackage .= "use $importPackageName;\n";
      }else{
        die "[STDERR] In line $lineNu: Syntax error at end of line: ';' expected\n";
      }
    }elsif($thisline[0] eq "method"){
      @thisline = grep length, split /[\s\(\)]/, $lines[$index];
      my @nameOfClass = grep length, split /\./, $thisline[1];
      my $nameReal;
      if($#nameOfClass != 0){
        $nameReal = join("::", @nameOfClass);
      }else{
        $nameReal = $thisline[1];
      }
      $POOLedPackage .= $nameReal . "(";
      
      my @cc = grep length, split '', $thisline[2];
      if($cc[0] eq "\""){
        $POOLedPackage .= join(" ", @thisline[2..$#thisline-1]);
        $POOLedPackage .= ");\n";
      }elsif($thisline[2] eq "vector"){
        $POOLedPackage .= "\@".$thisline[3].");\n";
      }elsif($thisline[2] eq "void"){
        $POOLedPackage .= ");\n";
      }else{
        die "[STDERR] In line $lineNu: unknown type in method ()\n";
      }
    }elsif($thisline[0] eq "__inline.Perl__"
      && $inlineState == 0){
      $inlineState = 1;
      print "[Debug] inlineState is true\n";
    }elsif($thisline[0] ne "__inline.end__"
      && $inlineState == 1){
      $POOLedPackage .= $lines[$index]."\n";
    }elsif($inlineState == 1 && $thisline[0] eq "__inline.end__"){
      print "[Debug] inlineState is false\n";
      $inlineState = 0;
    }elsif($inlineState == 0 && $thisline[0] eq "__inline.end__"){
      die "[STDERR] In line $lineNu: __inline.end__ called when inlineState is false!\n";
    }
}
 
print "[Debug] Creating PoolExportClass handle and class\n";
open my$PoolExportClassHandler, ">$PoolExportClassFile"
  or die "[STDERR] Couldn't open or create $PoolExportClassFile!\n[Perl] " . $! . "\n";
  
print "[Debug] Unloading export class\n";
print $PoolExportClassHandler $POOLedPackage;

close($PoolExportClassHandler);

print "[Done]\n"
